COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00004 00003		! saves on a file any tty input. The file can be managed only by AL_CLOSE
C00007 00004	! input/output:      altf,altrans,alframe,aldec,al_subtree,alid
C00012 00005	! input/output:      readexec,readcode,writecode,alfile,close,al_close
C00021 ENDMK
C⊗;
ENTRY;
BEGIN "INPOUT"

REQUIRE "MACROS.SAI[PNT,HE]"SOURCE_FILE;
REQUIRE "RECORD.DEF[PNT,HE]" SOURCE_FILE;

STRING  ARRAY $NAMEFL[1:10] ;  			! symbol table of files used;
INTEGER ARRAY $CHNFL[1:10,0:1];			! open/closed and ch #;
EXTERNAL INTEGER $TOTFL;			! number of files defined;
EXTERNAL STRING  $ALFL;				! last file used for output;
INTEGER $ALCH;					! $ALCH=channel used for output;
INTEGER $INPCH;					! channel # for input;


EXTERNAL BOOLEAN $OUT;				! if true output is required;
EXTERNAL STRING  $TTYFL;			! name of file for tty input;
EXTERNAL INTEGER $TTYCH;			! channel # to output any tty input;

EXTERNAL STRING $OULST;
EXTERNAL STRING $BLANK;
EXTERNAL INTEGER $EOF,$BRCHR;
EXTERNAL INTEGER $ERRTAB,$BSKTAB;

EXTERNAL PROCEDURE ABORT1(STRING ERR1,ERR2(NULL));
EXTERNAL STRING PROCEDURE FRCVER(STRING FILE);
EXTERNAL PROCEDURE ESC_P;

EXTERNAL STRING PROCEDURE NAMEFILE;		! in PARSER.SAI;
EXTERNAL STRING $TAIL;
			! in OUTPUT.SAI;

EXTERNAL SIMPLE STRING PROCEDURE CVGX(REAL R);
EXTERNAL SIMPLE STRING PROCEDURE STR_RT(REAL ARRAY XF;INTEGER NUM(1));  
EXTERNAL SIMPLE STRING PROCEDURE STR_VT(REAL X,Y,Z;INTEGER NUM(1));
EXTERNAL SIMPLE STRING PROCEDURE STR_TR(REAL ARRAY XF;INTEGER ROT(1),VECT(1));
	! saves on a file any tty input. The file can be managed only by AL_CLOSE;
	! The AL_CLOSE instruction without parameters closes all open files and
	  asks for a new tty save file. Upon exit the file is automatically closed;

INTERNAL PROCEDURE TTYSAVE;
	BEGIN
	STRING ANSWER;
	OUTSTR("file for TTY output=");ESC_P;
	ANSWER←INCHWL; CLRBUF;
	$TAIL←SCAN(ANSWER,$BSKTAB,$BRCHR);	! scan to eliminate $BLANK;
	! reads from tail and return a file name;
	IF $TAIL
	   THEN BEGIN
		ANSWER←NAMEFILE;
		OPEN($TTYCH←GETCHAN,"DSK",0,0,2,0,0,$EOF);
		$EOF←-1;
		ENTER($TTYCH,ANSWER,$EOF);
		WHILE $EOF 
		     DO	BEGIN
			PRINT("enter failed");
			ANSWER←FRCVER(ANSWER);
			ENTER($TTYCH,ANSWER,$EOF);
			END;
		$OUT←TRUE;
		$TTYFL←ANSWER;
		$OULST←NULL;
		END
	   ELSE $OUT←FALSE;
	END;

	! returns a string with the names of files used for output and their 
	  state (open/closed);
INTERNAL STRING PROCEDURE FILE_STRING;
	BEGIN
	INTEGER I;STRING TS;
	TS←NULL;
	FOR I←1 STEP 1 UNTIL $TOTFL 
	     DO	BEGIN
		IF EQU($NAMEFL[I],$ALFL) 
		   THEN TS←TS&"*"
		   ELSE TS←TS&" ";
		TS←TS&"OC"[1+$CHNFL[I,0] FOR 1]&":"&$NAMEFL[I]&CRLF;
		END;
	RETURN(TS);
	END;

! input/output:      altf,altrans,alframe,aldec,al_subtree,alid;

	! types on the file (open on $ALCH) the frame declaration and assignment
	  of affixment for the frame pointed by nd. If the frame is affixed 
	  independently an assignment instruction is generated, otherwhise an
	  affix instruction, with the correct type of affixment is produced;

PROCEDURE ALDEC(RPTR(FRAME) ND);       
	BEGIN
	STRING NAME,DS,FS;
 	NAME←FRAME:PNAME[ND];				! frame pname;
	DS←"FRAME "&NAME&";"&CRLF;			! declaration;
 	IF FRAME:HOWLINKED[ND]=#INDLK
	   THEN FS←NAME&" ← FRAME"&STR_TR(FRAME:XF[ND])&";"&DLF
	   ELSE BEGIN
        	FS←"AFFIX "&NAME&" TO "&FRAME:PNAME[FRAME:DAD[ND]]&" AT"
			&CRLF&$BLANK[1 TO 6]&"TRANS"&STR_TR(FRAME:XF[ND]);
		IF FRAME:HOWLINKED[ND]=#NRGLK
		   THEN FS←FS&" NONRIGIDLY;"&DLF
		   ELSE FS←FS&" RIGIDLY;"&DLF;
		END;
	CPRINT($ALCH,DS,FS);
	END;

	! finds the different frames looking at the frame tree;

RECURSIVE PROCEDURE FR_OUT(RPTR(FRAME) ND);
	BEGIN
	RPTR(FRAME) SN;
	IF ND≠F_WRLD AND ND≠F_YARM AND ND≠F_BARM AND ND≠F_POINTER 
	AND ND≠F_BPARK AND ND≠F_YPARK AND ND≠F_FID 
	   THEN ALDEC(ND);
	SN←FRAME:SON[ND];
	WHILE SN≠NULL_RECORD 
	     DO	BEGIN
		FR_OUT(SN);       
	 	SN←FRAME:EBRO[SN];
		END;
	END;

	! types on the file (open on $ALCH) the scalar declarations and
	  assignments;

PROCEDURE ST_OUT(INTEGER TYPE);
	BEGIN "U"
	INTEGER ADDRIN,ADDRFN,I;
	RPTR(SYMBOL)ADDR;STRING DS,VS;
	ADDRIN←#LTYPE*(TYPE-#MIN);			! initial address in $YMTAB;
	ADDRFN←$ENTRY[TYPE]-1;			! final address;
	DS←VS←NULL;
   	FOR I←ADDRIN STEP 1 UNTIL ADDRFN DO
 	    BEGIN "D"
	    ADDR←$YMTAB[I];			! if null_record is a deleted symb;
	    IF ADDR≠NULL_RECORD
	       THEN CASE TYPE OF
		  BEGIN "CASE"
		  [#SC] 
	        	IF ADDR≠INCHES AND ADDR≠DEG  AND ADDR≠HANDB AND ADDR≠HANDY
			   THEN BEGIN "SC"
				DS←"SCALAR "&SYMBOL:PNAME[ADDR]&";"&CRLF;	
				VS←SYMBOL:PNAME[ADDR]&" ← "
				   &CVGX(SCALAR:VALUE[SYMBOL:OBJECT[ADDR]])&";"&DLF;
				CPRINT($ALCH,DS,VS);
				END "SC";
		  [#VT]
			IF ADDR≠XHAT AND ADDR≠YHAT AND ADDR≠ZHAT AND ADDR≠NILVECT
			   THEN BEGIN "VT"
				RPTR(VECTOR)IND;
				IND←SYMBOL:OBJECT[ADDR];
				DS←"DISTANCE VECTOR "&SYMBOL:PNAME[ADDR]&";"&CRLF;
				VS←SYMBOL:PNAME[ADDR]&" ← "
				   &STR_VT(VECTOR:XC[IND],VECTOR:YC[IND],
				   VECTOR:ZC[IND]) &";"&DLF;
				CPRINT($ALCH,DS,VS);
				END "VT";
		  [#RT] IF ADDR≠NILROTN
			   THEN BEGIN "RT"
				DS←"ROT "&SYMBOL:PNAME[ADDR]&";"&CRLF;
				VS←SYMBOL:PNAME[ADDR]&" ← "
				   &STR_RT(ROT:XF[SYMBOL:OBJECT[ADDR]])&";"&DLF;
				CPRINT($ALCH,DS,VS);
				END "RT";
		  [#TR] IF ADDR≠NILTRANS
			   THEN BEGIN	"TR"
				DS←"TRANS "&SYMBOL:PNAME[ADDR]&";"&CRLF;
				VS←SYMBOL:PNAME[ADDR]&" ← TRANS"
				   &STR_TR(TRANS:XF[SYMBOL:OBJECT[ADDR]])&";"&DLF;
				CPRINT($ALCH,DS,VS);
				END "TR"
		END "CASE";
	   END "D";
	END "U";
! input/output:      readexec,readcode,writecode,alfile,close,al_close;

	! if the file has been previously used returns its number in table,
	  otherwise returns 0;

INTERNAL INTEGER PROCEDURE ISFILE(STRING FILE);
	BEGIN
	INTEGER I;
	FOR I←1 STEP 1 UNTIL $TOTFL DO
	    IF EQU($NAMEFL[I],FILE) THEN RETURN (I);
	RETURN(0);
	END;

SIMPLE  PROCEDURE OPENFL(REFERENCE STRING FILE;INTEGER IND(0));
	BEGIN 
	INTEGER ALEOF;
 	OPEN($ALCH←GETCHAN,"DSK",0,1,3,0,0,ALEOF);
	ALEOF←-1;
	ENTER($ALCH,FILE,ALEOF);
	WHILE ALEOF 
	     DO	BEGIN
		PRINT(" enter failed ");
		FILE←FRCVER(FILE);
		ENTER($ALCH,FILE,ALEOF);
		END;
 	IF IND>0 
 	   THEN BEGIN
 		$CHNFL[IND,0]←0;			! file existent closed;
 		$CHNFL[IND,1]←$ALCH;
 		END
 	   ELSE BEGIN
		$TOTFL←$TOTFL+1;			! one new file;
		$NAMEFL[$TOTFL]←FILE;			! name;
		$CHNFL[$TOTFL,1]←$ALCH;			! channel number;
	 	$CHNFL[$TOTFL,0]←0;			! file open;
 		END;
	$OULST←NULL;					! file status modified;
	END;

INTERNAL PROCEDURE FCLOSE;
	BEGIN
	INTEGER IND;
	FOR IND←1 STEP 1 UNTIL $TOTFL DO
	    BEGIN
	    $CHNFL[IND,0]←1;  				! sets the file closed in table;
	    PRINT("CLOSING ",$NAMEFL[IND],CRLF); ESC_P;
	    RELEASE($CHNFL[IND,1]);			! releases channels;
	    $ALFL←"DECLAR.AL";				! new default file;
	    END;
	IF $OUT
	   THEN BEGIN
		PRINT("CLOSING ",$TTYFL,CRLF);ESC_P;
		RELEASE($TTYCH,0);			! closes the tty save file;
		$OUT←FALSE;				! sets the flag;
		END;
	END;

	! close the file open;

INTERNAL PROCEDURE AL_CLOSE(STRING FILE );
	BEGIN
       	INTEGER IND;
 	IND←ISFILE(FILE);				! address of file in table;
	WHILE IND=0
	     DO	BEGIN
		PRINT("file not existent ");
		FILE←FRCVER(FILE);			! recovers not existent file;
		IND←ISFILE(FILE);
		END;
 	$CHNFL[IND,0]←1;				! closes the file;
 	RELEASE($CHNFL[IND,1]);
	! looks for an open file: if no file is open DECLAR.AL is proposed;
	$ALFL←"DECLAR.AL";			
	IND←$TOTFL;
	WHILE IND DO
	     IF $CHNFL[IND,0] 
		THEN IND←IND-1
		ELSE BEGIN
	 	     $ALFL←$NAMEFL[IND];		! name of open file;
		     DONE;
		     END;
	$OULST←NULL;					! file status modified;
	END;

INTERNAL PROCEDURE WRITECODE(STRING FILE;RPTR(FRAME) ROOT);
	BEGIN
	INTEGER IND;
	! checks if file exists and if it's open, otherwise open it;
	IND←ISFILE(FILE);
	IF IND = 0
	   THEN	OPENFL(FILE)
	   ELSE IF $CHNFL[IND,0]
		   THEN BEGIN
			STRING STR;
			PRINT("file existent, but closed (type Y to overwrite)");
			STR←INCHRW;IF STR=CR THEN STR←INCHRW;
			PRINT(CRLF);
			IF STR="Y" OR str="y"
			   THEN OPENFL(FILE,IND)
			   ELSE ABORT1("not executed instruction");
			END
		   ELSE $ALCH←$CHNFL[IND,1];		! channel number;
	! updates information for display;
	IF NOT EQU(FILE,$ALFL)
	   THEN BEGIN
		$ALFL←FILE;				! last file used for output;
		$OULST←NULL;	
		END;
	! output on the file;
	IF ROOT=F_WRLD
	   THEN BEGIN					! complete output;
		ST_OUT(#SC);				! outputs the scalars;
		ST_OUT(#VT);				! outputs th vectors;
		ST_OUT(#RT);				! outputs the rotations;
		ST_OUT(#TR);				! outputs the transes;
		END;
	FR_OUT(ROOT);					! outputs the frame tree;
	END;

PROCEDURE SAVE1(STRING FILE);
	BEGIN
	STRING OLDCNT;
	CLOSO($ALCH);					! closes the file;
	ENTER($ALCH,FILE,$EOF);				! enters the new file;
	WHILE $EOF 
	     DO	BEGIN
		PRINT("file not existent");
		FILE←FRCVER(FILE);
		ENTER($ALCH,FILE,$EOF);
		END;
	OPEN($INPCH←GETCHAN,"DSK",0,3,0,2000,$BRCHR,$EOF); 
	LOOKUP($INPCH,FILE,$EOF);
	WHILE $EOF
	     DO	BEGIN
		PRINT("lookup failed for file ");
		FILE←FRCVER(FILE);
		LOOKUP($INPCH,FILE,$EOF);
		END;
	! the file is copied into the new file;
	WHILE $EOF=0 DO 
		BEGIN
 		OLDCNT←INPUT($INPCH,0);
 		CPRINT($ALCH,OLDCNT);
		END;
	END;

INTERNAL PROCEDURE SAVECODE(STRING FILE;RPTR(FRAME)ROOT);
	BEGIN
       	INTEGER IND,ALEOF;
 	IND←ISFILE(FILE);				! address of file in table;
	IF IND=0 
	   THEN BEGIN
		WRITECODE(FILE,ROOT);
		SAVE1(FILE);
		END
	   ELSE IF $CHNFL[IND,0]=0
		   THEN BEGIN
			$ALCH←$CHNFL[IND,1];
			SAVE1(FILE);
			END;
	END;

INTERNAL PROCEDURE FSAVE;					! saves all open files;
	BEGIN
	INTEGER I;
	FOR I←1 STEP 1 UNTIL  $TOTFL DO
	   IF $CHNFL[I,0]=0
		THEN  BEGIN
		      $ALCH←$CHNFL[I,1];
		      SAVE1($NAMEFL[I]);
		      END;
	IF $OUT
	   THEN BEGIN
		$ALCH←$TTYCH;
		SAVE1($TTYFL);
		END;
	END;

END "INPOUT";